home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Utility / ResEdit / Icons / Explode Cicn / Source files / UCicn.inc1.p < prev    next >
Encoding:
Text File  |  1990-12-06  |  19.1 KB  |  740 lines  |  [TEXT/MPS ]
  1. CONST
  2.     cConvert = 3001;
  3.     cConvertMsg = 3101;
  4.     cICNN                = 4001;
  5.     cicl4                = 4002;
  6.     cicl8                = 4003;
  7.     cics                = 4004;
  8.     cics4                = 4005;
  9.     cics8                = 4006;
  10.     
  11.     kFileType = 'rsrc';
  12.     kSignature = 'RSED';
  13.     kWindowID = 1001;
  14.     kIconID = 1000;
  15.     kCicnHeight = 32;
  16.     kCicnWidth = 32;
  17.     kIconWidth = 32;
  18.  
  19.     kIcl8Bytes = 1024;
  20.     kIcl4Bytes = 512;
  21.     kICNBytes = 256;
  22.     kIcs8Bytes = 256;
  23.     kIcs4Bytes = 128;
  24.     kIcsBytes = 64;
  25.     
  26. Var
  27.     g1BitOPM : TOffScreenPixMap;
  28.     g4BitOPM : TOffScreenPixMap;
  29.     g8BitOPM : TOffScreenPixMap;
  30.  
  31.  
  32. {================TCicnApplication====================}
  33. {$S AInit}
  34. Procedure TCicnApplication.ICicnApplication;
  35.     Var
  36.         aCicnView : TCicnView;
  37.         a1BitOPM : TOffScreenPixMap;
  38.         a4BitOPM : TOffScreenPixMap;
  39.         a8BitOPM : TOffScreenPixMap;
  40.     begin
  41.         If gDeadStripSuppression Then
  42.             Begin
  43.                 New(aCicnView);
  44.             End;
  45.         SELF.IApplication(kFileType);
  46.         SELF.fLaunchWithNewDocument := FALSE;
  47.         {create the three off screen pixmaps}
  48.         New(a1BitOPM);
  49.         FailNIL(a1BitOPM);
  50.         a1BitOPM.IOffScreenPixMap(1);
  51.         g1BitOPM := a1BitOPM;
  52.         New(a4BitOPM);
  53.         FailNIL(a4BitOPM);
  54.         a4BitOPM.IOffScreenPixMap(4);
  55.         g4BitOPM := a4BitOPM;
  56.         New(a8BitOPM);
  57.         FailNIL(a8BitOPM);
  58.         a8BitOPM.IOffScreenPixMap(8);
  59.         g8BitOPM := a8BitOPM;
  60.     end;
  61.  
  62. {$S AInit}
  63.     Function TCicnApplication.DoMakeDocument(itsCmdNumber : CmdNumber) : 
  64.                                                                                                             TDocument; OVERRIDE;
  65.         var
  66.             aCicnDocument : TCicnDocument;
  67.             aWindow : TWindow;
  68.         begin
  69.             NEW(aCicnDocument);
  70.             FailNIL(aCicnDocument);
  71.             aCicnDocument.ICicnDocument;
  72.             DoMakeDocument := aCicnDocument;
  73.         end;
  74.  
  75. {================TCicnDocument====================}
  76. {$S AOpen}
  77. Procedure TCicnDocument.ICicnDocument;
  78.     var
  79.         aList : TList;
  80.     Begin
  81.         fSaveIcon := True;
  82.         fSaveIcl4 := True;
  83.         fSaveIcl8 := True;
  84.         fSaveIcs := True;
  85.         fSaveIcs4 := True;
  86.         fSaveIcs8 := True;
  87.         fCicnList := NIL;
  88.         SELF.IDocument(kFileType, kSignature, NOT kUsesDataFork, 
  89.                                      kUsesRsrcFork, NOT kDataOpen, kRsrcOpen);
  90.         fSavePrintInfo := FALSE;
  91.         aList := NewList;
  92.         fCicnList := aList;
  93.         SELF.fRsrcPerm := fsRdWrPerm;
  94.         {$IFC qDebug}
  95.         fCicnList.SetEltType('TCicn');
  96.         {$ENDC}
  97.     end;
  98.  
  99. {$S AOpen}
  100. Procedure TCicnDocument.DoMakeViews(forPrinting : boolean); OVERRIDE;
  101.     var
  102.         aWindow : TWindow;
  103.         aCicnView : TCicnView;
  104.         aHandler : TStdPrintHandler;
  105.         minSize, maxSize : Point;
  106.     begin
  107.         aWIndow := NewTemplateWindow(kWIndowID, SELF);
  108.         SetPt(minSize, 64, 64);
  109.         SetPt(maxSize, 303, 480);
  110.         aWIndow.SetResizeLimits(minSize, maxSize);
  111.         aCicnView := TCicnView(aWindow.FindSubView('Cicn'));
  112.         fCicnView := aCicnView;
  113.         NEW(aHandler);
  114.         FailNIL(aHandler);
  115.         aHandler.IStdPrintHandler(SELF,aCicnView, NOT kSquareDots, kFixedSize,
  116.                                                             NOT kFixedSize);
  117.     End;
  118.  
  119. {$S ARes}
  120. Procedure TCicnDocument.DoSetupMenus; OVERRIDE;
  121.     Begin
  122.         INHERITED DoSetupMenus;
  123.         Enable(cConvert, SELF.fCicnList.GetSize > 0);
  124.         EnableCheck(cICNN, SELF.fCicnList.GetSize > 0, SELF.fSaveIcon);
  125.         EnableCheck(cicl4, SELF.fCicnList.GetSize > 0, SELF.fSaveicl4);
  126.         EnableCheck(cicl8, SELF.fCicnList.GetSize > 0, SELF.fSaveicl8);
  127.         EnableCheck(cics,  SELF.fCicnList.GetSize > 0, SELF.fSaveics);
  128.         EnableCheck(cics4, SELF.fCicnList.GetSize > 0, SELF.fSaveics4);
  129.         EnableCheck(cics8, SELF.fCicnList.GetSize > 0, SELF.fSaveics8);
  130.     End;
  131.  
  132. {$S ASelCommand}
  133. Function  TCicnDocument.DoMenuCommand(aCmdNumber : CmdNumber) : TCommand; OVERRIDE;
  134.     Begin
  135.         Case aCmdNumber Of
  136.             cConvert :
  137.                 SELF.DoWrite(SELF.fRsrcRefNum, FALSE);
  138.             cICNN :
  139.                 SELF.fSaveIcon := Not(SELF.fSaveIcon);
  140.             cicl4 :
  141.                 SELF.fSaveIcl4 := Not(Self.fSaveIcl4);
  142.             cicl8 :
  143.                 SELF.fSaveIcl8 := Not(Self.fSaveIcl8);
  144.             cics :
  145.                 SELF.fSaveIcs := Not(Self.fSaveIcs);
  146.             cics4 :
  147.                 SELF.fSaveIcs4 := Not(Self.fSaveIcs4);
  148.             cics8 :
  149.                 SELF.fSaveIcs8 := Not(Self.fSaveIcs8);
  150.             Otherwise
  151.                 DoMenuCommand := INHERITED DoMenuCommand(aCmdNUmber);
  152.         End; {Case}
  153.     End;
  154.  
  155. {$S ARes}
  156. Procedure TCicnDocument.ForEachCicnDo(Procedure Something(aCicn : TCicn));
  157.     Begin
  158.         fCicnList.Each(Something);
  159.     End;
  160.  
  161. {$S AWriteFile}
  162. Procedure TCicnDocument.DoNeedDiskSpace(VAR dataForkBytes, 
  163.                     rsrcForkBytes : LongInt); OVERRIDE;
  164.     Var
  165.         numOfCicns, bytesPerRsrc : LongInt;
  166.     Begin
  167.         INHERITED DoNeedDiskSpace(dataForkBytes, rsrcForkBytes);
  168.         numOfCicns := fCicnList.GetSize;
  169.         bytesPerRsrc := 0;
  170.         If SELF.fSaveIcon Then
  171.             bytesPerRsrc := bytesPerRsrc + kICNBytes;
  172.         If SELF.fSaveIcl4 Then
  173.             bytesPerRsrc := bytesPerRsrc + kIcl4Bytes;
  174.         If SELF.fSaveIcl8 Then
  175.             bytesPerRsrc := bytesPerRsrc + kIcl8Bytes; 
  176.         If SELF.fSaveIcs Then
  177.             bytesPerRsrc := bytesPerRsrc + kIcsBytes;
  178.         If SELF.fSaveIcs4 Then
  179.             bytesPerRsrc := bytesPerRsrc + kIcs4Bytes;
  180.         If SELF.fSaveIcs8 Then
  181.             bytesPerRsrc := bytesPerRsrc + kIcs8Bytes; 
  182.         bytesPerRsrc := bytesPerRsrc + kRsrcOverhead;
  183.         rsrcForkBytes := rsrcForkBytes + numOfCicns * bytesPerRsrc + 6 * kRsrcTypeOverhead;
  184.     End;
  185.  
  186. {$S AReadFile}
  187. Procedure TCicnDocument.DoRead(aRefNum : integer; rsrcExists, 
  188.                     forPrinting : Boolean); OVERRIDE;
  189.     var
  190.         numberOfCicns : Integer;
  191.         aCicn : TCicn;
  192.         index : Integer;
  193.     Begin
  194.         INHERITED DoRead(aRefNum, rsrcExists, forPrinting);
  195.         numberOfCicns := Count1Resources('cicn');
  196.         FailResError;
  197.         For index := 1 to numberOfCicns do
  198.             Begin
  199.                 New(aCicn);
  200.                 FailNil(aCicn);
  201.                 aCicn.ICicn(SELF);
  202.                 aCicn.ReadCicn(index);
  203.                 SELF.AddCicnLast(aCicn);
  204.             End;
  205.     End;
  206.  
  207. {$S AWriteFile}
  208. Procedure TCicnDocument.DoWrite(aRefNum : integer; makingCopy : Boolean); OVERRIDE;
  209.     Var
  210.         hPB : HParamBlockRec;
  211.         freeBlks, blkSize, neededBlks, usedBlks : LongInt;
  212.         dataBytes, rsrcBytes : LongInt;
  213.         err : OSErr;
  214.         name:                Str255;
  215.         volRefnum:            INTEGER;
  216.                     
  217.     Procedure Local(aCicn : TCicn);
  218.         Begin
  219.             aCicn.fCicnHandle := GetCIcon(aCicn.fId);
  220.             aCicn.WriteResources(aRefNum);
  221.             DisposCIcon(aCicn.fCicnHandle);
  222.         End;
  223.  
  224.     Begin
  225.     {Get information about the volume saving to}
  226.     WITH hPB DO
  227.         BEGIN
  228.         ioNamePtr := NIL;
  229.         ioVRefnum := SELF.fVolRefnum;
  230.         ioVolIndex := 0;
  231.         END;
  232.     FailOSerr(PBHGetVInfo(@hPB, FALSE));
  233.  
  234.         {on HFS ioVFrBlk is an unsigned INTEGER; on MFS it is
  235.             limited to a positive signed INTEGER}
  236.     freeBlks := BAND(hPB.ioVFrBlk, $0000FFFF) - 1;        {-1 for some slop -- don't try to fill up
  237.                                                          the disk completely}
  238.  
  239.     {compute size needed to save document}
  240.     blkSize := hPB.ioVAlBlkSiz;
  241.  
  242.     dataBytes := 0;
  243.     rsrcBytes := 0;
  244.     DoNeedDiskSpace(dataBytes, rsrcBytes);
  245.     neededBlks := NumBlocks(rsrcBytes, blkSize) + NumBlocks(dataBytes, blkSize);
  246.  
  247.     IF freeBlks >= neededBlks THEN
  248.         Begin
  249.             INHERITED DoWrite(aRefNum, makingCopy);
  250.             SELF.ForEachCicnDo(Local);
  251.         End
  252.     Else
  253.         Failure(dskFulErr, 0);
  254.     {$IFC qDebug}
  255.     err := GetFileInfo(name, volRefnum, hPB);
  256.     IF err = noErr THEN
  257.         BEGIN
  258.         usedBlks := NumBlocks(hPB.ioFlRPyLen, blkSize) + NumBlocks(hPB.ioFlPyLen, blkSize);
  259.         IF usedBlks <> neededBlks THEN
  260.             BEGIN
  261.             Writeln('In TDocument.Save: DoNeedDiskSpace estimated disk space incorrectly.');
  262.             Writeln('estimated # disk blocks = ', neededBlks: 1);
  263.             Writeln('   actual # disk blocks = ', usedBlks: 1);
  264.             END;
  265.         END;
  266.     {$ENDC}
  267.     End;
  268.  
  269. {$S AClose}
  270. Procedure TCicnDocument.Free; OVERRIDE;
  271.     begin
  272.         If fCicnList <> NIL then
  273.             fCicnList.FreeList;
  274.         INHERITED Free;
  275.     end;
  276.  
  277. {$S AReadFile}
  278. Procedure TCicnDocument.FreeData; OVERRIDE;
  279.     Begin
  280.         fCicnList.FreeAll; {frees TCicn objects only}
  281.     End;
  282.  
  283. {$S ASelCommand}
  284. Procedure TCicnDocument.AddCicnLast(aCicn : TCicn);
  285.     Begin
  286.         fCicnList.InsertLast(aCicn);
  287.     End;
  288.  
  289. {$S ASelCommand}
  290. Procedure TCicnDocument.DeleteCicn(aCicn : TCicn);
  291.     Begin
  292.         fCicnList.Delete(aCicn);
  293.     End;
  294.  
  295. {$S ASelCommand}
  296. Function TCicnDocument.CicnAt(theIndex : Integer) : TCicn;
  297.     Begin
  298.         CicnAt := TCicn(fCicnList.At(theIndex));
  299.     End;
  300.  
  301. {$IFC qDebug}
  302. Procedure TCicnDocument.Fields(Procedure DoToField(
  303.                     fieldName : Str255; fieldAddr : Ptr; fieldType :
  304.                     integer)); OVERRIDE;
  305.     Begin
  306.         DoToField('TCicnDocument', NIL, bClass);
  307.         DoToField('fCicnList', @fCicnList, bObject);
  308.         DoToField('fCicnView', @fCicnView, bObject);
  309.         DoToField('fSaveIcon', @fSaveIcon, bBoolean);
  310.         DoToField('fSaveIcl4', @fSaveIcl4, bBoolean);
  311.         DoToField('fSaveIcl8', @fSaveIcl8, bBoolean);
  312.         DoToField('fSaveIcs', @fSaveIcs, bBoolean);
  313.         DoToField('fSaveIcs4', @fSaveIcs4, bBoolean);
  314.         DoToField('fSaveIcs8', @fSaveIcs8, bBoolean);
  315.         INHERITED Fields(DoToField);
  316.     End;
  317. {$ENDC}
  318.  
  319. {=============================    TCicnView ================================}
  320. {$S ARes}
  321. Procedure TCicnView.IRes(itsDocument : TDocument; itsSuperView : TView;
  322.                                                 Var itsParams : Ptr); OVERRIDE;
  323.     Var
  324.         numOfCicns, numOfRows : Integer;
  325.     Begin
  326.         INHERITED Ires(itsDocument, itsSUperView, itsParams);
  327.         fCicnDocument := TCicnDocument(itsDocument);
  328.         numOfCicns := SELF.fCicnDocument.fCicnList.GetSize;
  329.         If numOfCicns > 0 Then
  330.             Begin
  331.                 numOfRows := (numOfCicns + 7) DIV 8 - 1;
  332.                 SELF.InsRowLast(numOfRows, 36);
  333.             End;
  334.     End;
  335.  
  336. {$S ARes}
  337. Procedure TCicnView.DrawCell(aCell : GridCell; aQDRect : Rect); OVERRIDE;
  338.     Var
  339.         theCicn : Integer;
  340.         aCicn : TCicn;
  341.     Begin
  342.         theCicn := (aCell.v - 1) * 8 + aCell.h;
  343.         if theCicn <= SELF.fCicnDocument.fCicnList.GetSize Then
  344.             Begin
  345.                 aCicn := SELF.fCicnDocument.CicnAt(theCicn);
  346.                 aCicn.DrawCicn(aQDRect);
  347.             End;
  348.     End;
  349.  
  350. {$IFC qDebug}
  351.     Procedure TCicnView.Fields(Procedure DoToField(
  352.                         fieldName : Str255; fieldAddr : Ptr; fieldType :
  353.                         integer)); OVERRIDE;
  354.         Begin
  355.             DoToField('TCicnView', NIL, bClass);
  356.             DoToField('fCicnDocument', @fCicnDocument, bObject);
  357.             INHERITED Fields(DoToField);
  358.         End;
  359. {$ENDC}
  360.  
  361. {============================= TCicn =============================}
  362. {$S ASelCommand}
  363. Procedure TCicn.ICicn(aCicnDocument : TCicnDocument);
  364.     Begin
  365.         SELF.fId := 128;
  366.         SELF.fName := '';
  367.         SELF.fCicnHandle := NIL;
  368.         SELF.fCicnDocument := aCicnDocument;
  369.     End;
  370.  
  371. {$S ARes}
  372. Procedure TCicn.DrawCicn(theRect : Rect);
  373.     Type
  374.         BitMapPtr = ^BitMap;
  375.     Var
  376.         srcRect : Rect;
  377.         oldPort : CGrafPtr;
  378.         oldDevice : GDHandle;
  379.         theCicn : CIconHandle;
  380.     Begin
  381.         theCicn := GetCIcon(SELF.fId);
  382.         If gPrinting Then
  383.             Begin {since PlotCIcon does not use QD picture calls, have to copybits from opm}
  384.                 GetPort(GrafPtr(oldPort));
  385.                 oldDevice := GetGDevice;
  386.                 SetGDevice(g8BitOPM.fGDevice);
  387.                 SetPort(GrafPtr(g8BitOPM.fCGrafPtr));
  388.                 srcRect := g8BitOPM.fCGrafPtr^.portPixMap^^.bounds;
  389.                 EraseRect(srcRect);
  390.                 PlotCIcon(srcRect, theCicn);
  391.                 SetPort(GrafPtr(oldPort));
  392.                 SetGDevice(oldDevice);
  393.                 RGBForeColor(gRGBBlack);
  394.                 RGBBackColor(gRGBWhite);
  395.                 CopyBits(BitMapPtr(g8BitOPM.fCGrafPtr^.portPixMap^)^, GrafPtr(oldPort)^.portBits , 
  396.                     g8BitOPM.fCGrafPtr^.portPixMap^^.bounds, theRect, srcCopy, NIL);
  397.             End
  398.         Else
  399.             PlotCIcon(theRect, theCicn);
  400.         DisposCIcon(theCicn);
  401.     End;
  402.  
  403. {$S AWrite}
  404. Function TCicn.ExtractRsrc(theDepth : Integer; halfSize : Boolean) : Handle;
  405.     Var
  406.         oldPort : CGrafPtr;
  407.         oldDevice : GDHandle;
  408.         theRsrc : Handle;
  409.         theCicn : CIconHandle;
  410.         theRect : Rect;
  411.         theOPM : TOffScreenPixMap;
  412.         cntr : Integer;
  413.         bytesPerRow : LongInt;
  414.     Begin
  415.         GetPort(GrafPtr(oldPort));
  416.         oldDevice := GetGDevice;
  417.         theCicn := SELF.fCicnHandle;
  418.         Case theDepth of
  419.             1: theOPM := g1BitOPM;
  420.             4: theOPM := g4BitOPM;
  421.             8: theOPM := g8BitOPM;
  422.         Otherwise;
  423.         End;
  424.         If halfSize Then
  425.             theRsrc := NewPermHandle(theOPM.fSize DIV 4)
  426.         Else
  427.             theRsrc := NewPermHandle(theOPM.fSize);
  428.         FailNil(theRsrc);
  429.         SetGDevice(theOPM.fGDevice);
  430.         SetPort(GrafPtr(theOPM.fCGrafPtr));
  431.         theRect := theOPM.fCGrafPtr^.portPixMap^^.bounds;
  432.         If halfSize Then
  433.             Begin
  434.                 theRect.bottom := theRect.bottom DIV 2;
  435.                 theRect.right := theRect.right DIV 2;
  436.             End;
  437.         EraseRect(theRect);
  438.         PlotCIcon(theRect, theCicn);
  439.         If halfSize Then
  440.             Begin
  441.                 bytesPerRow := (theOPM.fCGrafPtr^.portPixMap^^.rowBytes - $8000) DIV 2;
  442.                 for Cntr := 1 to (theRect.bottom - theRect.top) Do
  443.                     BlockMove(Pointer(Ord(theOPM.fBits) + (cntr - 1) * bytesPerRow * 2),
  444.                                         Pointer(Ord(theRsrc^) + (cntr - 1) * bytesPerRow), bytesPerRow);
  445.             End
  446.         Else
  447.             BlockMove(theOPM.fBits, theRsrc^, theOPM.fSize);
  448.         ExtractRsrc := theRsrc;
  449.         SetGDevice(oldDevice);
  450.         SetPort(GrafPtr(oldPort));
  451.     End;
  452.  
  453. {$S AWrite}
  454. Function TCicn.ExtractMask(halfSize : Boolean) : Handle;
  455.     Type
  456.         BitMapPtr = ^BitMap;
  457.     Var
  458.         oldPort : CGrafPtr;
  459.         oldDevice : GDHandle;
  460.         theRect : Rect;
  461.         theRsrc : Handle;
  462.         cntr : Integer;
  463.         bytesPerRow : LongInt;
  464.     Begin
  465.         GetPort(GrafPtr(oldPort));
  466.         oldDevice := GetGDevice;
  467.         If halfSize Then
  468.             theRsrc := NewPermHandle(g1BitOPM.fSize DIV 4)
  469.         Else
  470.             theRsrc := NewPermHandle(g1BitOPM.fSize);
  471.         FailNIL(theRsrc);
  472.         SetGDevice(g1BitOPM.fGDevice);
  473.         SetPort(GrafPtr(g1BitOPM.fCGrafPtr));
  474.         RGBForeColor(gRGBBlack);
  475.         RGBBackColor(gRGBWhite);
  476.         theRect := g1BitOPM.fCGrafPtr^.portPixMap^^.bounds;
  477.         If halfSize Then
  478.             Begin
  479.                 theRect.bottom := theRect.bottom DIV 2;
  480.                 theRect.right := theRect.right DIV 2;
  481.             End;
  482.         EraseRect(theRect);
  483.         CopyBits(SELF.fCicnHandle^^.iconMask, BitMapPtr(g1BitOPM.fCGrafPtr^.portPixMap^)^,
  484.             Self.fCicnHandle^^.iconMask.bounds, theRect, srcCopy, NIL);
  485.         If halfSize Then
  486.             Begin
  487.                 bytesPerRow := (g1BitOPM.fCGrafPtr^.portPixMap^^.rowBytes - $8000) DIV 2;
  488.                 For cntr := 1 to (theRect.bottom - theRect.top) Do
  489.                     BlockMove(Pointer(Ord(g1BitOPM.fBits) + (cntr - 1) * bytesPerRow * 2),
  490.                                         Pointer(Ord(theRsrc^) + (cntr - 1) * bytesPerRow), bytesPerRow);
  491.             End
  492.         Else
  493.             BlockMove(g1BitOPM.fBits, theRsrc^, g1BitOPM.fSize);
  494.         ExtractMask := theRsrc;
  495.         SetGDevice(oldDevice);
  496.         SetPort(GrafPtr(oldPort));
  497.     End;
  498.  
  499. {$S AWriteFile}
  500. Procedure TCicn.RemoveOldResources(id : Integer);
  501.  
  502.     Procedure RemoveThem(theType : ResType);
  503.         Var
  504.             theResHandle : Handle;
  505.         Begin
  506.             theResHandle := Get1Resource(theType, id);
  507.             While theResHandle <> NIL Do
  508.                 Begin
  509.                     RmveResource(theResHandle);
  510.                     FailResError;
  511.                     theResHandle := Get1Resource(theType, id);
  512.                 End;
  513.         End;
  514.  
  515.     Begin
  516.         SetResLoad(False);
  517.         If SELF.fCicnDocument.fSaveIcon Then
  518.             RemoveThem('ICN#');
  519.         If SELF.fCicnDocument.fSaveIcs  Then
  520.             RemoveThem('ics#');
  521.         If SELF.fCicnDocument.fSaveIcl4 Then
  522.             RemoveThem('icl4');
  523.         If SELF.fCicnDocument.fSaveIcs4 Then
  524.             RemoveThem('ics4');
  525.         If SELF.fCicnDocument.fSaveIcl8 Then
  526.             RemoveThem('icl8');
  527.         If SELF.fCicnDocument.fSaveIcs8 Then
  528.             RemoveThem('ics8');
  529.         SetResLoad(True);
  530.     End;
  531.  
  532. {$S AWriteFile}
  533. Procedure TCicn.WriteResources(aRefNum : integer);
  534.     Var
  535.         theRes, theMask : Handle;
  536.  
  537.     Procedure AddNewRes(typeOfRes : ResType);
  538.         Var
  539.             resName : Str255;
  540.         Begin
  541.             resName := SELF.fName;
  542.             AddResource(theRes, typeOfRes, SELF.fId, resName);
  543.             FailResError;
  544.             WriteResource(theRes);
  545.             FailResError;
  546.             ReleaseResource(theRes); {don't need the ICON in memory since it has been written out}
  547.             FailResError;
  548.         End;
  549.             
  550.     Begin
  551.         SELF.RemoveOldResources(SELF.fId);
  552.         If SELF.fCicnDocument.fSaveIcon Then
  553.             Begin
  554.                 theRes := SELF.ExtractRsrc(1, False);
  555.                 theMask := SELF.ExtractMask(False);
  556.                 FailOSErr(HandAndHand(theMask, theRes));
  557.                 AddNewRes('ICN#');
  558.                 DisPosIfHandle(theMask);
  559.             End;
  560.         If SELF.fCicnDocument.fSaveIcs  Then
  561.             Begin
  562.                 theRes := SELF.ExtractRsrc(1, True);
  563.                 theMask := SELF.ExtractMask(True);
  564.                 FailOSErr(HandAndHand(theMask, theRes));
  565.                 AddNewRes('ics#');
  566.                 DisPosIfHandle(theMask);
  567.             End;
  568.         If SELF.fCicnDocument.fSaveIcl4  Then
  569.             Begin
  570.                 theRes := SELF.ExtractRsrc(4, False);
  571.                 AddNewRes('icl4');
  572.             End;
  573.         If SELF.fCicnDocument.fSaveIcs4 Then
  574.             Begin
  575.                 theRes := SELF.ExtractRsrc(4, True);
  576.                 AddNewRes('ics4');
  577.             End;
  578.         If SELF.fCicnDocument.fSaveIcl8  Then
  579.             Begin
  580.                 theRes := SELF.ExtractRsrc(8, False);
  581.                 AddNewRes('icl8');
  582.             End;
  583.         If SELF.fCicnDocument.fSaveIcs8 Then
  584.             Begin
  585.                 theRes := SELF.ExtractRsrc(8, True);
  586.                 AddNewRes('ics8');
  587.             End;
  588.     End;
  589.  
  590. {$S AWriteFile}
  591. Function TCicn.ReturnBytes : LongInt;
  592.     Begin
  593.     {$PUSH} {$H-}
  594.         ReturnBytes := 1024 + 512 + 256 + 12;
  595.     {$POP}
  596.     End;
  597.  
  598. {$S ARes}
  599. Procedure TCicn.Free; OVERRIDE;
  600.     Begin
  601.         SELF.fId := 0;
  602.         SELF.fName := '';
  603.         SELF.fCicnHandle := NIL;
  604.         INHERITED Free;
  605.     End;
  606.  
  607. {$S AReadFile}
  608. Procedure TCicn.ReadCicn(index : Integer);
  609.     Var
  610.         theId : Integer;
  611.         theType : ResType;
  612.         theName : Str255;
  613.         theCicnHandle : Handle;
  614.     Begin
  615.         SetResLoad(FALSE);    {only load in the Handle to the resource for now}
  616.         theCicnHandle := Get1IndResource('cicn', index);
  617.         GetResInfo(theCicnHandle, theId, theType, theName);
  618.         SELF.fId := theId;
  619.         SELF.fName := theName;
  620.         SetResLoad(TRUE);
  621.     End;
  622.  
  623. {$S ASelCommand}
  624. Function TCicn.ReturnFrame : Rect;
  625.     Begin
  626.     End;
  627.  
  628. {$IFC qDebug}
  629.     Procedure TCicn.Fields(Procedure DoToField(fieldName : Str255;
  630.                                                 fieldAddr : Ptr; fieldType : Integer)); OVERRIDE;
  631.     Begin
  632.         DoToField('TCicn', NIL, bClass);
  633.         DoToField('fId', @fId, bInteger);
  634.         DoToField('fName', @fName, bString);
  635.         DoToField('fCicnHandle', @fCicnHandle, bHandle);
  636.         INHERITED Fields(DoToField);
  637.     End;
  638. {$ENDC}
  639.  
  640. {============================= TCicn =============================}
  641. Procedure TOffScreenPixMap.IOffScreenPixMap(theDepth : Integer);
  642.     Var
  643.         bRect : Rect;
  644.         aCGrafPtr : CGrafPtr;
  645.         theRowBytes, size : Longint;
  646.         cntr : Integer;
  647.         bits : Ptr;
  648.         theDevice, oldDevice : GDHandle;
  649.     Begin
  650.         oldDevice := GetGDevice;
  651.         SELF.fCGrafPtr := NIL;
  652.         SELF.fBits := NIL;
  653.         SELF.fGDevice := NIL;
  654.         SELF.fSize := 0;
  655.         SetRect(bRect, 0, 0, 32, 32);
  656.         theRowBytes := (((theDepth * 32) + 15) DIV 16) * 2;
  657.         size := LongInt(32 * theRowBytes);
  658.         SELF.fSize := size;
  659.         bits := NewPermPtr(size);
  660.         FailNil(bits);
  661.         SELF.fBits := bits;
  662.         {create a graphics device}
  663.         theDevice := NewGDevice(0, -1);
  664.         FailNIL(theDevice);
  665.         SELF.fGDevice := theDevice;
  666.         LockHandleHigh(Handle(SELF.fGDevice));
  667.         With SELF.fGDevice^^ Do
  668.             Begin
  669.                 gdId := 0;
  670.                 gdType := 0; {CLUT device}
  671.                 {set up color table}
  672.                 LockHandleHigh(Handle(gdPMap));
  673.                 DisposCTable(gdPMap^^.pmTable);
  674.                 gdPMap^^.pmTable := GetCTable(theDepth);
  675.                 FailNIL(gdPMap^^.pmTable);
  676.                 FailOSErr(HandToHand(Handle(gdPMap^^.pmTable)));
  677.                 {$PUSH} {$R-}
  678.                 For cntr := 0 to gdPMap^^.pmTable^^.ctSize Do
  679.                     gdPMap^^.pmTable^^.ctTable[cntr].value := cntr;
  680.                 {$POP}
  681.                 gdPMap^^.pmTable^^.ctFlags := BAnd(gdPMap^^.pmTable^^.ctFlags, $7FFF);
  682.                 gdPMap^^.pmTable^^.ctSeed := GetCTSeed;
  683.                 {make inverse table}
  684.                 MakeITable(gdPMap^^.pmTable, gdITable, 3);
  685.                 FailOSErr(QDError);
  686.                 gdResPref := 3;
  687.                 gdSearchProc := NIL;
  688.                 gdCompProc := NIL;
  689.                 SetDeviceAttribute(theDevice, gdDevType , True);
  690.                 SetDeviceAttribute(theDevice, ramInit, True);
  691.                 SetDeviceAttribute(theDevice, noDriver, True);
  692.                 SetDeviceAttribute(theDevice, screenActive, True);
  693.                 With gdPMap^^ do
  694.                     Begin
  695.                         baseAddr := bits;
  696.                         rowBytes := theRowBytes + $8000;    {remember to be a PixMap}
  697.                         bounds := bRect;
  698.                         pixelSize := theDepth;
  699.                         cmpCount := 1;
  700.                         cmpSize := theDepth;
  701.                     End;
  702.                 HUnlock(Handle(gdPMap));
  703.                 gdRect := bRect;
  704.             End;
  705.         HUnlock(Handle(theDevice));
  706.         SetGDevice(theDevice);
  707.         aCGrafPtr := CGrafPtr(NewPermPtr(SizeOf(cGrafPort)));
  708.         FailNIL(aCGrafPtr);
  709.         SELF.fCGrafPtr := aCGrafPtr;
  710.         OpenCPort(aCGrafPtr);
  711.         SetGDevice(oldDevice);
  712.     End;
  713.  
  714. {$S Res}
  715. Procedure TOffScreenPixMap.Free; OVERRIDE;
  716.     Begin
  717.         DisPosIfPtr(SELF.fBits);
  718.         If SELF.fCGrafPtr <> NIL Then
  719.             Begin
  720.                 CloseCPort(SELF.fCGrafPtr);
  721.                 DisposPtr(Ptr(SELF.fCGrafPtr));
  722.             End;
  723.         If SELF.fGDevice <> NIL Then
  724.             DisposGDevice(SELF.fGDevice);
  725.         INHERITED Free;
  726.     End;
  727.  
  728. {$IFC qDebug}
  729.     Procedure TOffScreenPixMap.Fields(Procedure DoToField(fieldName : Str255;
  730.                                                     fieldAddr : Ptr; fieldType : Integer)); OVERRIDE;
  731.     Begin
  732.         DoToField('TOffScreenPixMap', NIL, bClass);
  733.         DoToField('fCGrafPtr', @fCGrafPtr, bPointer);
  734.         DoToField('fBits', @fBits, bPointer);
  735.         DoToField('fGDevice', @fGDevice, bHandle);
  736.         DoToField('fSize', @fSize, bLongInt);
  737.         INHERITED Fields(DoToField);
  738.     End;
  739. {$ENDC}
  740.